00010		SUBROUTINE PT2
00020		INTEGER VALID
00080		DIMENSION VALID(6),NBAR(36)
00100		DATA QLINE/140.0/,HX/2./,VALID/1,4,8,2,3,-2/
00200	C  QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00300	
00375	C  ADD MORE TO VALID LATER *****
00400		COMMON /SF/KL,RT,KP,STFSZ,NAMX
00500		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(200)
00700		COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
00800		1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1)
00900		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01000		1,(R8,RQ(6)),(R9,RQ(7)),(LCNT,IV(80)),(NDPY,IV(81))
01205	C  TRNSP'S Bb, F, BBb, A, G, Eb.
01300	103	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
01400	102	FORMAT(A5)
01500		TYPE 103
01600		ACCEPT 102,NAMX
01610		IF(NAMX.EQ.' ')NAMX='AAAAA'
01650	CC	IF(NAMX.EQ.' ')GO TO 102
01700		IF(LOOKF(NAMX).GE.0)GO TO 88
01800		TYPE 88,NAMX
01900		ACCEPT 102,L
02000		IF(L.EQ.'N')GO TO 103
02100	88	FORMAT(' WRITE OVER FILE ',A5,'????  '$)
02200	5	FORMAT(F,2I)
02210		IF(RS.NE.'OLD')GO TO 2000
02220		CALL GETFIL('PARTS')
02240		CALL FASTIN(RSTFAC,128)
02250		CALL FASTIN(KPN,JJ2)
02260		CALL FASTIN(Q,JPQ)
02300	CC	READ(1),L,LL,
02400	CC	1(PN(N),N=1,L+1),(Q(N),N=1,LL-1),J,RSTJ2,J,J,RSTFAC,STFF,IV,STFF
02410	2000	TYPE 144
02440	144	FORMAT(' STAFF SIZE, TRANSP.  '$)
02470		ACCEPT 5,RSTJ2,LL
02472		IF(MOD(LL,7).EQ.0)GO TO 140
02475		DO 40 L=1,6
02480	40	IF(LL.EQ.VALID(L))GO TO 140
02485		TYPE 240
02490		GO TO 2000
02495	240	FORMAT(' THIS TRANSP NOT OFFERED')
02500	140	IF(RSTJ2.EQ.0)RSTJ2=.9
02510		L=JJ2-2
02515		TR=LL
02520		IF(LL.NE.0)CALL TRNSP(L,TR)
02600		I=L
02700		KK=1
02800	CC	JJ=0
02900	CC	DO 7 K=1,L
03000	CC	N=PN(K)
03100	CC	IF(Q(N+1).NE.4)GO TO 7
03200	CC	JJ=JJ+1
03300	C  FOUND A BAR LINE
03400	CC	RN(JJ)=Q(N+3)
03500	CC7	CONTINUE
03600	CC	ENDLN=RN(JJ)
03650		ENDLN=ENDL(JJ)
03675	C  FUNCTION ENDL(JJ) (IN FAIL) DOES ALL ABOVE
03700	
03710		NA=1000
03750		N=0
03820		TYPE 90,JJ
03840		RA=0
03860	90	FORMAT(' NUMBER OF BARS PER LINE: TOTAL BAR LINES='I3/)
03870		ZLINE=QLINE
03900	9	KL=0
04000		XLINE=ZLINE
04100		J=0
04150		LL=0
04200		DO 8 K=1,JJ
04300		IF(RN(K).LT.XLINE)GO TO 8
04400		KP=K-KL
04500	C  NUMBER OF BARS, THIS LINE
04600	CC	TYPE 89,KP
04700		KL=K
04800		J=J+1
04810		IF(IV(J).NE.KP)LL=-1
04820		IV(J)=KP
04900		XLINE=RN(K)+ZLINE
05000		IF(ENDLN-XLINE.LT.80.)XLINE=ENDLN
05100	8	CONTINUE
05110		IF(LL)TYPE 108,RA,(IV(K),K=1,J)
05115		IF(RT)GO TO 105
05120	108	FORMAT(F6.2,8(3I3,1X))
05150	CC	TYPE 108
05160	CC108	FORMAT(/)
05200	CC89	FORMAT('+',I3,$)
05205		IF(J.GT.NA)GO TO 107
05210		IF(N.EQ.0)GO TO 105
05220	C  SKIP IF FIRST TIME
05230		IF(N.NE.KP)GO TO 106
05235		IF(J.EQ.NA)GO TO 105
05240	106	RT=.05
05260	C SHRINK OR EXPAND?
05270		RA=RA+RT
05280		ZLINE=QLINE*RS/RA
05285	CC	IF(RA.GT.J)GO TO 107
05290		GO TO 9
05300	107	FORMAT(' CAN''T DO IT!')
05310		TYPE 107
05400	105	TYPE 104,J
05500	104	FORMAT(I4,' LINES - OR TYPE N1, N2 --'$)
05550		KA=0
05600		ACCEPT 5,RA,N,KL
05650	C  TYPE 0,n  TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
05660		IF(KL.NE.0)GO TO 110
05680	C  FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
05700		IF(RA.EQ.0)GO TO 11
05800		IF(ZLINE.EQ.QLINE)RS=J
05820		NA=RA
05825		RT=NA-RA
05827		IF(RT)GO TO 109
05830		RA=RA-.6
05840	C  CHECK THIS ↑↑↑ NUMBER!
05850		IF(N.EQ.0)GO TO 90
05900	109	ZLINE=QLINE*RS/RA
05910		GO TO 9
05920	
05925	111	FORMAT(36I)
05930	110	REREAD 111,NBAR
05940		DO 112 K=36,1,-1
05945		KP=NBAR(K)
05950		KA=KA+KP
05960	112	IF(KP.EQ.0)KL=K
05970		IF(KA.NE.JJ)GO TO 107
05980	C  MISMATCH!
05990		N=26-2*MOD(KL-1,12)
06000		IF(N.EQ.26)N=0
06100	
06200	11	RA=0
06250		XLINE=ZLINE
06300		CLEF=-99
06400		JSLUR=0
06500		SIG=CLEF
06510		HX=2
06520		SP=2.45
06530		IF(N.EQ.0)GO TO 100
06540		HX=N
06550		SP=SP+(HX-2.)*.11
06560		LC=1
06600	100	KL=1
06700		KP=1
06800		RT=2
06900		J=KK
07000		HGT=HX*2.
07020		LB=0
07100	
07200		DO 1 K=KK,I
07300		N=KPN(K)
07400		IF(Q(N+1).NE.4)GO TO 1
07410		IF(KA.EQ.0)GO TO 334
07420		LB=LB+1
07430		IF(NBAR(LC).GT.LB)GO TO 1
07440	C FOR SPECIFIED BARS
07450		LC=LC+1
07460		LB=0
07470		GO TO 335
07600	334	IF(Q(N+3).LT.XLINE)GO TO 1
07700	C  FOUND LAST BAR LINE.
07710	335	RX=0
07720		MTR1=-1
07730		MTR2=-1
07740		LL=KPN(K+1)
07745	C TO ADD METER AT END OF BAR
07747		RS=Q(LL+1)
07748		IF(RS.LE.4)GO TO 3
07750		IF(RS.EQ.18)MTR1=LL
07755	C WHAT ABOUT REHRSL NUMS, ETC??
07770		LL=KPN(K+2)
07771		RS=Q(LL+1)
07775		IF(RS.LE.4)GO TO 3
07780		IF(RS.EQ.18)MTR2=LL
07790		LL=KPN(K+3)
07800		IF(Q(LL+1).EQ.18)MTR2=LL
07850		IF(MTR1.GT.0)GO TO 3
07862		MTR1=MTR2
07868		MTR2=-1
07875	C IN CASE IT SAW SOMETHING AHEAD OF NEW METER
07900	3	JJ=KP
08000	C PUTS IN STAFF
08100		RS=3.
08200		IF(RT.NE.0)GO TO 331
08300	C NEXT FOR BOTTOM STAFF.  PUTS IN SPACER.
08400		RS=6.
08500	CC	R8=SP
08600	331	CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,SP)
08700		HGT=HGT-HX
08800		IF(XLINE.EQ.ZLINE)GO TO 33
08900	CC	IF(XLINE.LT.ENDLN)GO TO 6
08905		IF(K.NE.I)GO TO 6
08910		IF(RT.EQ.0)GO TO 6
09000		RX=RT
09100		RT=0
09200		CALL STAFF(6.,8.,0,0,0,0,1.,SP)
09300	C  PUTS IN SPACER
09400		RT=RX
09500	6	IF(JSLUR.EQ.0)GO TO 2333
09510		LL=JSLUR
09520		JSLUR=0
09600	1333	CALL STAFF(5.,5.,0,Q(LL),Q(LL+1),11.5,Q(LL+3),0)
09700	2333	IF(JSL2.EQ.0)GO TO 333
09710		LL=JSL2
09715	C FOR 2ND SLUR AT END OF LINE.
09720		JSL2=0
09730		GO TO 1333
09800	333	IF(CLEF.EQ.-99)GO TO 33
09900	C  ONLY STAFF FOR FIRST LINE AT TOP.
10000		RX=10.*RSTJ2
10100	C  THE SPACER
10200		CALL STAFF(3.,3.,1.,0,CLEF,0,0,0)
10300		IF(SIG.EQ.-99)GO TO 33
10400		RS=4.
10500		R5=SIG
10600		RX=CLEF
10700		IF(R5.LT.50)GO TO 332
10800		RX=IFIX((R5+50.)/100.)
10900		R5=R5-RX*100.
11100	C  CLEF+SIG
11200	332	CALL STAFF(RS,17.,11.0*RSTJ2,0,R5,RX,0,0)
11300		RX=12.*RSTJ2
11400	
11500	33	R4=RA
11600		R5=Q(N+3)
11700		RS=0
11800		R7=RT
11900		R8=RX
12000		R9=200.
12100		LL=0
12200		L=K-J+1
12300		CALL PTMOVE(Q,KPN(J))
12400		RA=R5
12510	31	IF(MTR1)GO TO 231
12515		R=200.0+2.23*RSTJ2
12520		CALL STAFF(Q(MTR1),Q(MTR1+1),R,0,Q(MTR1+5),Q(MTR1+6),0,0)
12540	C  PUTS METER AFTER END OF STAFF
12555		IF(MTR2)GO TO 231
12565		R=200.0+6.7*RSTJ2
12567		CALL STAFF(Q(MTR2),Q(MTR2+1),R,0,Q(MTR2+5),Q(MTR2+6),0,0)
12585	C  PUTS METER AFTER END OF STAFF
12590	231	KB=KL
12600	131	DO 30 NA=KK,K
12700		KWDS(KP)=KB
12800		KP=KP+1
12900		JK=KPN(NA)
13000		R=Q(JK+1)
13100		IF(R.EQ.5)GO TO 135
13150		IF(R.NE.44)GO TO 35
13200	135	IF(Q(JK+6).LT.199.)GO TO 37
13300	C CATCHES END OF SLUR AND VARIOUS LINES
13500		IF(R.EQ.5)GO TO 235
13600	C  TO PUT SLUR ON NEXT LINE.
13620	535	Q(JK+6)=201.
13700		IF(R.EQ.5)GO TO 30
13750		GO TO 38
13760	235	IF(JSLUR.NE.0)GO TO 435
13770		JSLUR=JK+4
13780		GO TO 535
13790	435	JSL2=JK+4
13792	C FOR 2ND SLUR
13795		GO TO 535
13797	
13800	35	IF(R.NE.2)GO TO 36
13900		IF(Q(JK).LT.6.)GO TO 30
14000	CC	RR=Q(IFIX(PN(NA-1))+3)
14100		RR=RIGHT(NA,-1)
14200		IF(RR.GE.199.)RR=RX
14300	CC	Q(JK+3)=RR-1.6*RSTJ2+(Q(IFIX(PN(NA+1))+3)-RR)/2.
14400		Q(JK+3)=RR-1.6*RSTJ2+(RIGHT(NA,1)-RR)/2.
14500	C  FUNCTION 'RIGHT' FINDS RIGHT ITEMS FOR CENTERING.
14600	C CENTERS WHOLE REST
14700		GO TO 30
14800	36	IF(R.NE.3)GO TO 34
14900		RR=Q(JK+5)
15000		IF(Q(JK).LT.3)RR=0
15100		CLEF=RR
15200		GO TO 30
15300	34	IF(R.NE.17)GO TO 37
15400		SIG=Q(JK+5)
15500		IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
15600	C  CLEF # IN P6 WITH KEY SIGS.
15700	C  NEXT CHANGES CODE NUM BACK TO ORIGINAL
15800	37	IF(R.LT.33)GO TO 30
15850	38	Q(JK+1)=R/11.
15900	30	KB=KPN(NA+1)-KPN(NA)+KB
16000	
16100	CC	DO 31 NA=IFIX(PN(KK)),IFIX(PN(K+1)-1.)
16200	CC	RN(KL)=Q(NA)
16300	CC31	KL=KL+1
16400	CC	KK=K+1
16410		CALL PSHFT(KK,K)
16500		RS=RT
16600		LL='J'
16700		R4=0
16800		R5=200
16900		NA=L
17000		L=KP-JJ
17100		CALL PTMOVE(RN,KWDS(JJ))
17200		IF(K.EQ.I)GO TO 2
17300		L=NA
17400		J=K+1
17500	C  SO IT DOESN'T GO THRU ALL DATA
17600		RT=RT-1
17700		XLINE=RA+ZLINE
17800		IF(ENDLN-XLINE.LT.80.)XLINE=ENDLN
17900	10	IF(KL.GT.1700.OR.KP.GT.190.OR.RT)GO TO 2
18000	1	IF(K.EQ.I)GO TO 3
18100	CC2	L=KP
18200	CC	KWDS(KP+1)=KB
18250	2	KWDS(KP)=KB
18300		J=1
18400	CC	CALL OFILE(1,NAMX)
18500	CC	LL=KWDS(L+1)
18510		JJ2=KP+1
18548		JPQ=KB
18567	C  WRITES 1 EXTRA WORD
18600	CC2929	WRITE(1),L,LL,
18700	CC	1(KWDS(N),N=1,L+1),(RN(N),N=1,LL-1),J,J,J,J,RSTFAC,STFF,
18750	CC	1 (Q(N),N=1,78),STFF
18760		CALL PUTFIL(NAMX)
18769		LCNT=0
18773		NDPY=0
18778		CALL FASTOU(RSTFAC,128)
18784		CALL FASTOU(KWDS,JJ2)
18790		CALL FASTOU(RN,JPQ)
18800		TYPE 101,NAMX
18900	101	FORMAT(1XA5)
19000		IF(KK.GE.I)CALL EXIT
19100		NAMX=NAMX+2
19200		CALL FINFIL
19300		GO TO 100
19400		END
19500	
19600	CC	SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
19700	CC	COMMON/XRN/RN(2000) /SF/KL,RT,KP,RSTJ2,NAMX
19800	CC	COMMON /PTR/PWDS(250),L,LL,I,IX
19900	CC	PWDS(KP)=KL
20000	CC	KP=KP+1
20100	CC	RN(KL)=P0
20200	CC	RN(KL+1)=P1
20300	CC	RN(KL+2)=RT
20400	CC	RN(KL+3)=P3
20500	CC	RN(KL+4)=P4
20600	CC	RN(KL+5)=P5
20700	CC	IF(P0.LT.4.)GO TO 1
20800	CC	RN(KL+6)=P6
20900	CC	IF(P0.LT.5)GO TO 1
21000	CC	RN(KL+7)=P7
21100	CC	IF(P0.LT.6)GO TO 1
21200	CC	RN(KL+8)=P8
21300	CC1	KL=KL+P0+3.
21400	CC	END
21500	
21600	CC	FUNCTION RIGHT(NA,J)
21700	CC	COMMON /PX/PN(1800) /Q/Q(9000)
21800	CC	K=NA+J
21900	C  J IS EITHER +1 OR -1
22000	CC1	L=PN(K)
22100	CC	IF(Q(L+1).NE.16)GO TO 2
22200	CC	K=K+J
22300	CC	GO TO 1
22400	CC2	RIGHT=Q(L+3)
22500	CC	END